Summary

Row

confirmed

18,722

death

1,429 (7.6%)

Row

Daily cumulative cases by type (Ontario only)

Comparison

Column

Comparison daily cumulative confirmed cases

Column

Cases distribution by type

Logistic curve

Map

World map of cases (use + and - icons to zoom in/out)

About

Modified for Ontario

Added official Ontario results from the latest public data on COVID-19 cases in Ontario and the status dataset.

Added logistic curve for Ontario.


Formula: Y ~ K * Y0/(Y0 + (K - Y0) * exp(-r * X1))

Parameters:
    Estimate Std. Error t value Pr(>|t|)    
K  2.046e+04  3.104e+02   65.92   <2e-16 ***
r  1.167e-01  2.565e-03   45.48   <2e-16 ***
Y0 3.352e+02  2.360e+01   14.21   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 296.6 on 60 degrees of freedom

Number of iterations to convergence: 9 
Achieved convergence tolerance: 3.776e-06

The Coronavirus Dashboard: the case of Belgium

This Coronavirus dashboard: the case of Belgium provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Belgium. This dashboard is built with R using the R Makrdown framework and was adapted from this dashboard by Rami Krispin.

Code

The code behind this dashboard is available on GitHub.

Data

The input data for this dashboard is the dataset available from the {coronavirus} R package. Make sure to download the development version of the package to have the latest data:

install.packages("devtools")
devtools::install_github("RamiKrispin/coronavirus")

The data and dashboard are refreshed on a daily basis.

The raw data is pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus repository.

Contact

For any question or feedback, you can contact me. More information about this dashboard can be found in this article.

Update

The data is as of Tuesday May 05, 2020 and the dashboard has been updated on Wednesday May 06, 2020.

---
title: "COVID-19 Ontario Cases"
author: "Francis McKenna"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    # social: ["facebook", "twitter", "linkedin"]
    source_code: embed
    vertical_layout: fill
    self_contained: false
---

```{r setup, include=FALSE}
#------------------ Packages ------------------
options(stringsAsFactors = FALSE)

library(flexdashboard)
# install.packages("devtools")
# devtools::install_github("RamiKrispin/coronavirus", force = TRUE)

# correct Ontario data
# confirmed cases

url <- "https://data.ontario.ca/dataset/f4f86e54-872d-43f8-8a86-3892fd3cb5e6/resource/ed270bb8-340b-41f9-a7c6-e8ef587e6d11/download/covidtesting.csv"
ont_data <- read.csv(url)

ont_data <- ont_data[,c("Reported.Date", "Total.Cases", "Deaths", "Resolved")]
names(ont_data) <- c("Date", "confirmed_cum", "death_cum", "resolved_cum")
ont_data[is.na(ont_data)] <- 0
ont_data$Date <- as.Date(ont_data$Date)

ont_data$active_cum <- ont_data$confirmed_cum - ont_data$death_cum

ont_data$confirmed <- ont_data$confirmed_cum - c(0, ont_data$confirmed_cum[-nrow(ont_data)])
ont_data$death <- ont_data$death_cum - c(0, ont_data$death_cum[-nrow(ont_data)])
ont_data$active <- ont_data$active_cum - c(0, ont_data$active_cum[-nrow(ont_data)])
ont_data$recovered <- ont_data$resolved_cum - c(0, ont_data$resolved_cum[-nrow(ont_data)])

fst_case <- ont_data$Date[min(which(ont_data$confirmed_cum > 0L))]
fst_death <- ont_data$Date[min(which(ont_data$death_cum > 0L))]

# load JHU Coronavirus data

url <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv"
global_cases <- read.csv(url)

url <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_global.csv"
global_deaths <- read.csv(url)

url <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_recovered_global.csv"
global_recov <- read.csv(url)

library(reshape2)
coronavirus <- melt(global_cases, id.vars = c("Province.State", "Country.Region", "Lat", "Long"))
coronavirus$Date <- as.Date(coronavirus$variable, "X%m.%d.%y")
coronavirus$variable <- "confirmed"

tmp <- melt(global_deaths, id.vars = c("Province.State", "Country.Region", "Lat", "Long"))
tmp$Date <- as.Date(tmp$variable, "X%m.%d.%y")
tmp$variable <- "death"

coronavirus <- rbind(coronavirus, tmp)

tmp <- melt(global_recov, id.vars = c("Province.State", "Country.Region", "Lat", "Long"))
tmp$Date <- as.Date(tmp$variable, "X%m.%d.%y")
tmp$variable <- "recovered"

coronavirus <- rbind(coronavirus, tmp)

#library(coronavirus)
#data(coronavirus)
#update_datasets(silence = FALSE)

cond <- coronavirus$Province.State == "Ontario"
corona2 <- coronavirus[!cond,]

mn_dt <- min(c(corona2$Date, ont_data$Date))
mx_dt <- max(c(corona2$Date, ont_data$Date))

# confirmed first
tmp <- data.frame(Province.State = "Ontario",
            Country.Region = "Canada",
            Lat = 51.2538,
            Long = -85.3232,
            variable = "confirmed",
            value = 0L,
            Date = seq(mn_dt, mx_dt, 1L))

tmp$value <- ifelse(tmp$Date %in% ont_data$Date, 
                    ont_data$confirmed[match(tmp$Date, ont_data$Date)],
                    0L)

corona2 <- rbind(corona2, tmp)

# death next
tmp <- data.frame(Province.State = "Ontario",
                  Country.Region = "Canada",
                  Lat = 51.2538,
                  Long = -85.3232,
                  variable = "death",
                  value = 0L,
                  Date = seq(mn_dt, mx_dt, 1L))

tmp$value <- ifelse(tmp$Date %in% ont_data$Date, 
                    ont_data$death[match(tmp$Date, ont_data$Date)],
                    0L)

corona2 <- rbind(corona2, tmp)

# recovered next
tmp <- data.frame(Province.State = "Ontario",
                  Country.Region = "Canada",
                  Lat = 51.2538,
                  Long = -85.3232,
                  variable = "recovered",
                  value = 0L,
                  Date = seq(mn_dt, mx_dt, 1L))

tmp$value <- ifelse(tmp$Date %in% ont_data$Date, 
                    ont_data$recovered[match(tmp$Date, ont_data$Date)],
                    0L)

corona2 <- rbind(corona2, tmp)

names(corona2) <- c("Province.State", "Country.Region", "Lat", "Long", "type", "cases", "Date")


`%>%` <- magrittr::`%>%`
#------------------ Parameters ------------------
# Set colors
# https://www.w3.org/TR/css-color-3/#svg-color
confirmed_color <- "purple"
active_color <- "#1f77b4"
recovered_color <- "forestgreen"
death_color <- "red"
#------------------ Data ------------------
df <- corona2 %>%
  dplyr::filter(Country.Region == "Canada" & Province.State == "Ontario") %>%
  dplyr::group_by(Country.Region, type) %>%
  dplyr::summarise(total = sum(cases)) %>%
  tidyr::pivot_wider(
    names_from = type,
    values_from = total
  ) %>%
  dplyr::mutate(unrecovered = confirmed - ifelse(is.na(death), 0, death)) %>%
  dplyr::arrange(-confirmed) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(country = dplyr::if_else(Country.Region == "United Arab Emirates", "UAE", Country.Region)) %>%
  dplyr::mutate(country = dplyr::if_else(country == "Mainland China", "China", country)) %>%
  dplyr::mutate(country = dplyr::if_else(country == "North Macedonia", "N.Macedonia", country)) %>%
  dplyr::mutate(country = trimws(country)) %>%
  dplyr::mutate(country = factor(country, levels = country))


df_daily <- corona2 %>%
  dplyr::filter(Country.Region == "Canada" & Province.State == "Ontario") %>%
  dplyr::group_by(Date, type) %>%
  dplyr::summarise(total = sum(cases, na.rm = TRUE)) %>%
  tidyr::pivot_wider(
    names_from = type,
    values_from = total
  ) %>%
  dplyr::arrange(Date) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(active = confirmed - death) %>%
  dplyr::mutate(
    confirmed_cum = cumsum(confirmed),
    death_cum = cumsum(death),
    recovered_cum = cumsum(recovered),
  )


df1 <- corona2 %>% dplyr::filter(Date == max(Date))

```

Summary
=======================================================================

Row {data-width=400}
-----------------------------------------------------------------------

### confirmed {.value-box}

```{r}

valueBox(
  value = paste(format(sum(df$confirmed), big.mark = ","), "", sep = " "),
  caption = "Total confirmed cases",
  icon = "fas fa-user-md",
  color = confirmed_color
)
```
















### death {.value-box}

```{r}

valueBox(
  value = paste(format(sum(df$death, na.rm = TRUE), big.mark = ","), " (",
    round(100 * sum(df$death, na.rm = TRUE) / sum(df$confirmed), 1),
    "%)",
    sep = ""
  ),
  caption = "Death cases (death rate)",
  icon = "fas fa-heart-broken",
  color = death_color
)
```


Row
-----------------------------------------------------------------------

### **Daily cumulative cases by type** (Ontario only)
    
```{r}
plotly::plot_ly(data = df_daily) %>%
  plotly::add_trace(
    x = ~Date,
    # y = ~active_cum,
    y = ~confirmed_cum,
    type = "scatter",
    mode = "lines+markers",
    # name = "Active",
    name = "Confirmed",
    line = list(color = active_color),
    marker = list(color = active_color)
  ) %>%
  plotly::add_trace(
    x = ~Date,
    y = ~death_cum,
    type = "scatter",
    mode = "lines+markers",
    name = "Death",
    line = list(color = death_color),
    marker = list(color = death_color)
  ) %>%
  plotly::add_annotations(
    x = fst_case,
    y = 1,
    text = paste("First case"),
    xref = "x",
    yref = "y",
    arrowhead = 5,
    arrowhead = 3,
    arrowsize = 1,
    showarrow = TRUE,
    ax = -10,
    ay = -90
  ) %>%
  plotly::add_annotations(
    x = fst_death,
    y = 3,
    text = paste("First death"),
    xref = "x",
    yref = "y",
    arrowhead = 5,
    arrowhead = 3,
    arrowsize = 1,
    showarrow = TRUE,
    ax = -90,
    ay = -90
  ) %>%
  plotly::layout(
    title = "",
    yaxis = list(title = "Cumulative number of cases"),
    xaxis = list(title = "Date"),
    legend = list(x = 0.1, y = 0.9),
    hovermode = "compare"
  )
```

Comparison
=======================================================================


Column {data-width=400}
-------------------------------------


### **Comparison daily cumulative confirmed cases**
    
```{r}
daily_confirmed <- corona2 %>%
  dplyr::filter(type == "confirmed") %>%
  dplyr::filter(Country.Region != "Canada" | Country.Region == "Canada" & Province.State == "Ontario") %>%
  dplyr::mutate(country = Country.Region) %>%
  dplyr::group_by(Date, country) %>%
  dplyr::summarise(total = sum(cases)) %>%
  dplyr::ungroup() %>%
  tidyr::pivot_wider(names_from = country, values_from = total)

daily_confirmed$Canada <- cumsum(daily_confirmed$Canada)

for(i in 2:length(daily_confirmed)) {
  tmp <- daily_confirmed[,i]
  tmp <- tmp[tmp >= 100]
  if (length(tmp) < nrow(daily_confirmed)) {
    daily_confirmed[,i] <- c(tmp, rep(NA, nrow(daily_confirmed) - length(tmp)))
  } else {
    daily_confirmed[,i] <- tmp[1:nrow(daily_confirmed)]
  }
}
daily_confirmed$Date <- 1:nrow(daily_confirmed)
cond <- apply(daily_confirmed[,names(daily_confirmed) %in% c("Canada", "US","Spain","Italy")], 1, function(x) any(!is.na(x)))
daily_confirmed <- daily_confirmed[cond,]

mx_x <- 1.2 * nrow(daily_confirmed)
mx_y <- 1000000

shapes <- list()
annot <- list()
for(i in 1:10) {
  #lbl <- paste0("p",r)
  r <- 0.05 * i
  x0 <- 0
  y0 <- 100
  x1 <- mx_x
  y1 <- 100 * exp(r * mx_x)
  if (y1 > mx_y) {
    x1 <- log(mx_y / 100) / r
    y1 <- mx_y
  }
  shapes[[i]] <- list(
    type = "line", layer = "below",
    xref = "x", yref = "y",
    #xsizemode = "scaled", ysizemode = "scaled",
    x0 = x0, x1 = x1, y0 = y0, y1 = y1,
    line = list(color = "grey", width = 2, dash = "dot")
  )
  annot[[i]] <- list(
    text = paste0("",round(100 * r, 1),"%"),
    xref = "x", yref= "y",
    x = x1, 
    y = log(y1, 10), 
    showarrow = FALSE,
    font = list(family = "Arial", size = 14, color = "grey")
  )
}


#----------------------------------------
# Plotting the data

daily_confirmed %>%
  plotly::plot_ly() %>%
  plotly::add_trace(
    x = ~Date,
    y = ~Canada,
    type = "scatter",
    mode = "lines+markers",
    name = "Ontario"
  ) %>%
  plotly::add_trace(
    x = ~Date,
    y = ~US,
    type = "scatter",
    mode = "lines+markers",
    name = "United States"
  ) %>%
  plotly::add_trace(
    x = ~Date,
    y = ~Spain,
    type = "scatter",
    mode = "lines+markers",
    name = "Spain"
  ) %>%
  plotly::add_trace(
    x = ~Date,
    y = ~Italy,
    type = "scatter",
    mode = "lines+markers",
    name = "Italy"
  ) %>%
  plotly::layout(
    title = "",
    legend = list(x = 0.1, y = 0.9),
    yaxis = list(title = "Number of confirmed cases", 
                 type = "log", c(0, mx_y)),
    xaxis = list(title = "Days since 100 Cases or more", 
                 range = c(0, mx_x)),
    hovermode = "compare",
    margin = list(
      # l = 60,
      # r = 40,
      b = 10,
      t = 10,
      pad = 2
    ),
    shapes = shapes,
    annotations = annot
  )
```


Column {data-width=400}
-------------------------------------

 
### **Cases distribution by type**

```{r daily_summary}
df_EU <- corona2 %>%
  # dplyr::filter(date == max(date)) %>%
  dplyr::filter(Country.Region == "Canada" & Province.State == "Ontario" |
    Country.Region == "US" |
    Country.Region == "Italy" |
    Country.Region == "Spain") %>%
  dplyr::group_by(Country.Region, type) %>%
  dplyr::summarise(total = sum(cases)) %>%
  tidyr::pivot_wider(
    names_from = type,
    values_from = total
  ) %>%
  dplyr::mutate(unrecovered = confirmed - ifelse(is.na(death), 0, death)) %>%
  dplyr::arrange(confirmed) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(country = dplyr::if_else(Country.Region == "United Arab Emirates", "UAE", Country.Region)) %>%
  dplyr::mutate(country = dplyr::if_else(country == "Mainland China", "China", country)) %>%
  dplyr::mutate(country = dplyr::if_else(country == "North Macedonia", "N.Macedonia", country)) %>%
  dplyr::mutate(country = dplyr::if_else(country == "Canada", "Ontario", country)) %>%  dplyr::mutate(country = trimws(country)) %>%
  dplyr::mutate(country = factor(country, levels = country))


plotly::plot_ly(
  data = df_EU,
  x = ~country,
  # y = ~unrecovered,
  y = ~ confirmed,
  # text =  ~ confirmed,
  # textposition = 'auto',
  type = "bar",
  name = "Confirmed",
  marker = list(color = active_color)
) %>%
  plotly::add_trace(
    y = ~death,
    # text =  ~ death,
    # textposition = 'auto',
    name = "Death",
    marker = list(color = death_color)
  ) %>%
  plotly::layout(
    barmode = "stack",
    yaxis = list(title = "Total cases", type="log"),
    xaxis = list(title = ""),
    hovermode = "compare",
    margin = list(
      # l = 60,
      # r = 40,
      b = 10,
      t = 10,
      pad = 2
    )
  )
```

### **Logistic curve**


```{r logistic}
cond <- corona2$Province.State == "Ontario" & corona2$type == "confirmed"
df3 <- corona2[cond, c("Date", "cases")]
df3$cuml <- cumsum(df3$cases)
df3 <- df3[df3$cuml > 0,c("Date","cuml")]
df3 <- df3[!duplicated(df3$cuml),]
df3$X <- as.numeric(df3$Date - min(df3$Date))
df3$Y <- as.numeric(df3$cuml)
df3$X1 <- df3$X - 46

mod <- nls(Y ~ K * Y0 / (Y0 + (K - Y0)*exp(-r * X1)), data = df3[-(1:8),],
           start = c(K = 20000, r = 0.2, Y0 = 46))

pars <- mod$m$getAllPars()
K <- pars['K']
r <- pars['r']
Y0 <- pars['Y0']

df3$Ye <- K * Y0 / (Y0 + (K - Y0) * exp(-r * df3$X1))


# 
# 
# mod1 <- nls(I(log(Y)) ~ Const + r * X + I(log(K - Y + 0.1)),
#             data = df3[-(1:8),],
#             start = c(Const = 1, r = 0.18, K = 50000))
# 
# pars <- mod1$m$getAllPars()
# 
# a <- pars['K'] * exp(pars['Const'])
# r <- pars['r']
# b <- exp(pars['Const'])
# 
# df3$Ye <- a * exp(r * df3$X) / (1 + b * exp(r * df3$X))

# df3$Yp1 <- c(df3$Y[-1], NA)
# df3$Y2  <- df3$Y * df3$Y
# 
# mod2 <- lm(Yp1 ~ Y + Y2 + 0, data = df3)
# 
# r <- mod2$coefficients[1] - 1
# K <- -r / mod2$coefficients[2]
# 
# indx <- nrow(df3) %/% 2L
# X0 <- df3$X[indx]
# Y0 <- df3$Y[indx] #df3$Y[indx]
# 
# df3$X1 <- df3$X - X0 #- df3$X[indx]
# 
# df3$Ye <- K * Y0 / (Y0 + (K - Y0)*exp(-r*df3$X1))


addnl <- 1:30
tmp <- data.frame(Date = max(df3$Date) + addnl,
                  cuml = NA_integer_,
                  X = max(df3$X) + addnl,
                  Y = NA_real_,
                  X1 = max(df3$X1) + addnl)
# tmp$Ye <- a * exp(r * tmp$X) / (1 + b * exp(r * tmp$X))
tmp$Ye <-  K * Y0 / (Y0 + (K - Y0) * exp(-r * tmp$X1))

df3 <- rbind(df3, tmp)
names(df3) <- c("Date", "cuml", "X", "actual", "X1", "predicted")

df3 %>%
  plotly::plot_ly() %>%
  plotly::add_trace(
    x = ~Date,
    y = ~actual,
    type = "scatter",
    mode = "lines+markers",
    name = "Ontario actual"
  ) %>%
  plotly::add_trace(
    x = ~Date,
    y = ~predicted,
    type = "scatter",
    mode = "lines",
    name = "Ontario predicted"
  ) %>%
  plotly::layout(
    title = "",
    legend = list(x = 0.1, y = 0.9),
    yaxis = list(title = "Cumulative number of confirmed cases"),
    xaxis = list(title = "Days since first case"),
    # paper_bgcolor = "black",
    # plot_bgcolor = "black",
    # font = list(color = 'white'),
    hovermode = "compare",
    margin = list(
      # l = 60,
      # r = 40,
      b = 10,
      t = 10,
      pad = 2
    )
  )

```



Map
=======================================================================

### **World map of cases** (*use + and - icons to zoom in/out*)

```{r}
# map tab added by Art Steinmetz
library(leaflet)
library(leafpop)
library(purrr)
cv_data_for_plot <- corona2 %>%
  # dplyr::filter(Country.Region == "Belgium") %>%
  dplyr::filter(cases > 0) %>%
  dplyr::group_by(Country.Region, Province.State, Lat, Long, type) %>%
  #dplyr::summarise(cases = sum(cases)) %>%
  dplyr::mutate(log_cases = 2 * log(cases)) %>%
  dplyr::ungroup()

# need cumulative data for ontario

cond <- cv_data_for_plot$Province.State == "Ontario"
tmp <- cv_data_for_plot[cond,]
cv_data_for_plot <- cv_data_for_plot[!cond,]

tmp2 <- split(tmp, tmp$type)
tmp3 <- lapply(tmp2, 
               function(x) {
                 y <- x
                 y$cases <- cumsum(x$cases)
                 y
               })
tmp4 <- do.call("rbind", tmp3)

cv_data_for_plot <- rbind(cv_data_for_plot, tmp4)

cv_data_for_plot.split <- cv_data_for_plot %>% split(cv_data_for_plot$type)
pal <- colorFactor(c("orange", "red", "green"), domain = c("confirmed", "death", "recovered"))
map_object <- leaflet() %>% addProviderTiles(providers$Stamen.Toner)
names(cv_data_for_plot.split) %>%
  purrr::walk(function(df) {
    map_object <<- map_object %>%
      addCircleMarkers(
        data = cv_data_for_plot.split[[df]],
        lng = ~Long, lat = ~Lat,
        #                 label=~as.character(cases),
        color = ~ pal(type),
        stroke = FALSE,
        fillOpacity = 0.8,
        radius = ~log_cases,
        popup = leafpop::popupTable(cv_data_for_plot.split[[df]],
          feature.id = FALSE,
          row.numbers = FALSE,
          zcol = c("type", "cases", "Country.Region", "Province.State")
        ),
        group = df,
        labelOptions = labelOptions(
          noHide = F,
          direction = "auto"
        )
      )
  })

map_object %>%
  addLayersControl(
    overlayGroups = names(cv_data_for_plot.split),
    options = layersControlOptions(collapsed = FALSE)
  )
```





About
=======================================================================

**Modified for Ontario**

Added official Ontario results from the latest [public data on COVID-19 cases in Ontario](https://www.ontario.ca/page/2019-novel-coronavirus#section-0) and the [status dataset](https://data.ontario.ca/dataset/status-of-covid-19-cases-in-ontario).

Added logistic curve for Ontario.

```{r regression}
print(summary(mod))

```


**The Coronavirus Dashboard: the case of Belgium**

This Coronavirus dashboard: the case of Belgium provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Belgium. This dashboard is built with R using the R Makrdown framework and was adapted from this [dashboard](https://ramikrispin.github.io/coronavirus_dashboard/){target="_blank"} by Rami Krispin.

**Code**

The code behind this dashboard is available on [GitHub](https://github.com/AntoineSoetewey/coronavirus_dashboard){target="_blank"}.

**Data**

The input data for this dashboard is the dataset available from the [`{coronavirus}`](https://github.com/RamiKrispin/coronavirus){target="_blank"} R package. Make sure to download the development version of the package to have the latest data:

```
install.packages("devtools")
devtools::install_github("RamiKrispin/coronavirus")
```

The data and dashboard are refreshed on a daily basis.

The raw data is pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus [repository](https://github.com/RamiKrispin/coronavirus-csv){target="_blank"}.

**Contact**

For any question or feedback, you can [contact me](https://www.statsandr.com/contact/). More information about this dashboard can be found in this [article](https://www.statsandr.com/blog/how-to-create-a-simple-coronavirus-dashboard-specific-to-your-country-in-r/).

**Update**

The data is as of `r format(max(coronavirus$Date), "%A %B %d, %Y")` and the dashboard has been updated on `r format(Sys.time(), "%A %B %d, %Y")`.